open Data

(* ************** AST definition **************** *)

type turtle_ast = Prog_ast of (cmd list)
and cmd =
  Move_ast  of expr
| Turn_ast  of expr
| Call_ast  of string * (expr list)
| Set_ast   of string * expr
| If_ast    of expr   * turtle_ast    * turtle_ast
| While_ast of expr   * turtle_ast

| DecV_ast  of string
| DecP_ast  of string * (string list) * turtle_ast
| DecPR_ast of string * (string list) * turtle_ast
| DecF_ast  of string * (string list) * expr
| DecFR_ast of string * (string list) * expr

and expr =
    Num_ast of float
  | Id_ast  of string
  | CallFun_ast of string * (expr list)

  | True_ast
  | False_ast

  | Not_ast of expr
  | And_ast of expr * expr
  | Or_ast  of expr * expr

  | Equal_ast of expr * expr
  | Inf_ast  of expr * expr
  | Sup_ast   of expr * expr

  | Add_ast    of expr * expr
  | Minus_ast  of expr * expr
  | Mult_ast   of expr * expr
  | Div_ast    of expr * expr
  | UMinus_ast of expr

(* ******************** Tools ************************ *)

let bool_of_float i =
  if( i = 0.) then
    false
  else 
    true

let float_of_bool b =
  if(b) then
    1.
  else
    0.

(* trace of turtle for draw his path *)
let turtle_trace = ref [(0., 0.)]

(* ****************** Evaluation functions ********** *)


let rec eval_prog_ast ast env mem =
  match ast with
  | Prog_ast(cs) -> 
    eval_cs cs env mem

and eval_cs cs env mem = 
  printM mem;
  match cs with
  | [] -> mem
  | c::cs ->
    (match c with
      Move_ast _| Turn_ast _| Call_ast _| Set_ast _ | If_ast _
	| While_ast _ ->
	  eval_cs cs env (eval_c c env mem)
    | _  ->
      let (newEnv, newMem) = (eval_dec c env mem) in
      (eval_cs cs newEnv newMem))
      

and eval_c c env mem =
  match c with
  | Move_ast(e) -> 
    let n              = eval_expr e env mem                         in
    let (ang, x, y)    = ((getM mem 1), (getM mem 2), (getM mem 3))  in
    let (nang, nx, ny) = (ang, x+.(n*.(cos ang)), y+.(n*.(sin ang))) in
    turtle_trace := (!turtle_trace)@[(nx, ny)];
    setM (setM mem 2 nx) 3 ny
  | Turn_ast(e) -> 
    let n              = eval_expr e env mem   in
    let ang            = getM mem 1            in
    let nang           = ang +. (n*.pi/.180.)  in 
    setM mem 1 nang

  | Call_ast(id, args) -> 
    (match (getE id env) with
    | Proc(p) -> let eval_all_expr env mem e = eval_expr e env mem in
		 p (List.map (eval_all_expr env mem) args) mem
    | _       -> failwith "call doesn't match a procedure")
  | Set_ast (id, v)    -> 
    (match (getE id env) with
      Addr (a) -> setM mem a (eval_expr v env mem)
    | _ -> failwith ("id is not an address"))
  | If_ast(cond, cons, alt) ->
    let ce = bool_of_float (eval_expr cond env mem) in
    if(ce) then eval_prog_ast cons env mem
    else eval_prog_ast cons env mem
  | While_ast(e, p) ->
    let rec eval_while cond p we wm =
      if (bool_of_float (eval_expr cond we wm)) then
	eval_while cond p we (eval_prog_ast p we wm)
      else mem
    in eval_while e p env mem
  | _ -> failwith "command unknown"

and eval_dec d env mem =
  match d with
  | DecV_ast (x)  ->
    let (a, newMemory) = newM mem in
    ((addE x (Addr a) env), newMemory)
  | DecP_ast (f, x, Prog_ast(cs)) ->
    let fun_p = (fun v -> fun m -> eval_cs cs (addAllE x v env) m)  in
    ((addE f (Proc (fun_p)) env), mem)
  | DecPR_ast (f, x, Prog_ast(cs)) ->
    let rec fun_p = 
      (fun v -> fun m -> eval_cs cs (addE f (Proc(fun_p)) (addAllE x v env)) m)  in
    ((addE f (Proc (fun_p)) env), mem)
  | DecF_ast(f, x, e) ->
    let fun_f = fun v -> fun m -> eval_expr e (addAllE x v env) m in
    ((addE f (Fun(fun_f)) env), mem)
  | DecFR_ast(f, x, e) ->
    let rec fun_f = fun v -> fun m -> eval_expr e ((addE f (Fun(fun_f))) (addAllE x v env)) m in
    ((addE f (Fun(fun_f)) env), mem)
  | _ -> failwith "declaration: not yet implemented"
    
and eval_expr expr env mem =
  match expr with
  | Num_ast(n) -> n
  | Id_ast(id) -> 
    (match (getE id env) with
      Num  (v) -> v
    | Addr (a) -> (getM mem a)
    | _      -> failwith (id ^ "inconnu"))
  
  | Add_ast (left, right)   -> 
    (eval_expr left env mem) +. (eval_expr right env mem)
  | Minus_ast (left, right) -> 
    (eval_expr left env mem) -. (eval_expr right env mem)
  | Mult_ast (left, right)  -> 
    (eval_expr left env mem) *. (eval_expr right env mem)
  | Div_ast (left, right)   -> 
    (eval_expr left env mem) /. (eval_expr right env mem)
  | UMinus_ast(e)           ->  
    (0. -. (eval_expr e env mem))
      
  | Inf_ast (left, right)   -> 
    float_of_bool (bool_of_float (eval_expr left env mem) 
		   < 
		     bool_of_float (eval_expr right env mem))
  | Sup_ast (left, right)   -> 
    float_of_bool (bool_of_float (eval_expr left env mem) 
		   >
		     bool_of_float (eval_expr right env mem))
  | Equal_ast (left, right)   -> 
    float_of_bool (bool_of_float (eval_expr left env mem) 
		   =
		     bool_of_float (eval_expr right env mem))

  | CallFun_ast (id, args) ->
    (match (getE id env) with
    | Fun(f) -> let eval_all_expr env mem e = eval_expr e env mem in
		f (List.map (eval_all_expr env mem) args) mem
    | _ -> failwith "call doesn't match a function")
      
  | _ -> failwith "expr: command unknown"

let eval_turtle_ast ast =
  (eval_prog_ast ast emptyEnv emptyMem)
